﻿' Copyright (C) 2015 HTTPBuilder
'
' This program is free software: you can redistribute it and/or modify it under the +terms 
' of the GNU General Public License as published by the Free Software Foundation, either 
' version 3 of the License, or (at your option) any later version.

' This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
' without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
' See the GNU General Public License for more details.

' You should have received a copy of the GNU General Public License along with this program.
' If not, see http://www.gnu.org/licenses/. 

Imports System.ComponentModel
Imports System.Windows.Forms
Imports System.Text
Imports System.Security.Permissions
Imports System.Windows.Forms.VisualStyles
Imports HTTPBuilder.Interop

Namespace Controls
    ''' <summary>
    ''' 
    ''' </summary>
    ''' <remarks></remarks>
    Public Class XPTabControl

        'This field tells us whether custom drawing is turned on.
        Private fCustomDraw As Boolean
        Private _alignment As TabAlignment = TabAlignment.Bottom
        ' Handle to the font used for custom drawing. We do not use this native font directly but tab control
        ' adjusts size of tabs and tab scroller being based on the size of that font.
        Private fSysFont As IntPtr = IntPtr.Zero
        'required to correct pane height on Win Vista(and possible Win 7)
        Private Shared sAdjHeight As Integer = If(Environment.OSVersion.Version.Major >= 6, 1, 0)
        ' We have to remember the index of last hot tab for our native updown hook to overdraw that tab as
        ' normal when mouse is moving over it.
        Private lastHotIndex As Integer = -1

        'handle to our hook
        Private fUpDown As NativeUpDown

#Region "Constructor"
        ''' <summary>
        ''' Returns a new instnace of the XPTabControl
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub New()
            InitializeComponent()
            Me.fUpDown = New NativeUpDown(Me)
        End Sub
#End Region

        Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
            MyBase.OnPaint(e)
            'drawing our control
            DrawCustomTabControl(e.Graphics, e.ClipRectangle)
        End Sub

#Region "Public properties"
        <Browsable(True), DefaultValue(GetType(Color), "Control")> _
        Public Overloads Property BackColor As Color = SystemColors.Control

        <Browsable(True), DefaultValue(TabAlignment.Bottom)> _
        Public Overloads Property Alignment() As TabAlignment
            Get
                Return MyBase.Alignment
            End Get
            Set(ByVal value As TabAlignment)
                If (value <= TabAlignment.Bottom) Then
                    MyBase.Alignment = value
                End If
                'MyBase.Alignment = value
            End Set
        End Property

        <Browsable(True), DefaultValue(True)> _
        Public Overloads Property HotTrack() As Boolean
            Get
                Return MyBase.HotTrack
            End Get
            Set(ByVal value As Boolean)
                MyBase.HotTrack = value
            End Set
        End Property

        <Browsable(False), DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden), _
        EditorBrowsable(EditorBrowsableState.Never)> _
        Public Overloads Property Appearance() As TabAppearance
            Get
                Return MyBase.Appearance
            End Get
            Set(ByVal value As TabAppearance)
                If (value = TabAppearance.Normal) Then
                    MyBase.Appearance = value
                End If
            End Set
        End Property

        <Browsable(False), DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden), _
        EditorBrowsable(EditorBrowsableState.Never)> _
        Public Overloads Property DrawMode() As TabDrawMode
            Get
                Return MyBase.DrawMode
            End Get
            Set(ByVal value As TabDrawMode)
                If (value = TabDrawMode.Normal) Then
                    MyBase.DrawMode = value
                End If
            End Set
        End Property
        Public Overrides Property RightToLeft() As RightToLeft
            Get
                Return MyBase.RightToLeft
            End Get
            Set(ByVal value As RightToLeft)
                If (value = RightToLeft.No) Then
                    MyBase.RightToLeft = value
                End If
            End Set
        End Property
        Public Overrides Property RightToLeftLayout() As Boolean
            Get
                Return MyBase.RightToLeftLayout
            End Get
            Set(ByVal value As Boolean)
                If (Not value) Then
                    MyBase.RightToLeftLayout = value
                End If
            End Set
        End Property
#End Region

        ''' <summary>
        ''' Turns custom drawing on/off and sets native font for the control (it's required for tabs to
        ''' adjust their size correctly). If one doesn't install native font manually then Windows will
        ''' install ugly system font for the control.
        ''' </summary>
        Private Sub InitializeDrawMode()
            Me.fCustomDraw = Application.RenderWithVisualStyles AndAlso TabRenderer.IsSupported
            Me.SetStyle(ControlStyles.UserPaint Or ControlStyles.AllPaintingInWmPaint Or _
                ControlStyles.OptimizedDoubleBuffer, Me.fCustomDraw)
            Me.UpdateStyles()
            If (Me.fCustomDraw) Then 'custom drawing will be used
                If (Me.fSysFont = IntPtr.Zero) Then
                    Me.fSysFont = Me.Font.ToHfont()
                End If
                NativeMethods.SendMessage(Me.Handle, NativeMethods.WM_SETFONT, Me.fSysFont, CType(1, IntPtr))
            Else 'default drawing will be used
                ' Note that in the SendMessage call below we do not delete HFONT passed to control. If we do
                ' so we can see ugly system font. I think in this case the control deletes this font by itself
                ' when disposing or finalizing.
                NativeMethods.SendMessage(Me.Handle, NativeMethods.WM_SETFONT, Me.Font.ToHfont(), CType(1, IntPtr))
                'but we need to delete the font(if any) created when being in custom drawing mode
                If (Me.fSysFont <> IntPtr.Zero) Then
                    NativeMethods.DeleteObject(Me.fSysFont)
                    Me.fSysFont = IntPtr.Zero
                End If
            End If
        End Sub

        Protected Overrides Sub OnHandleCreated(ByVal e As EventArgs)
            MyBase.OnHandleCreated(e)
            'after the control has been created we should turn custom drawing on/off etc.
            InitializeDrawMode()
        End Sub

        Protected Overrides Sub OnFontChanged(ByVal e As EventArgs)
            MyBase.OnFontChanged(e)
            If (Me.fCustomDraw) Then
                ' The control is being custom drawn and managed font size is changed. We should inform system
                ' about such great event for it to adjust tabs' sizes. And certainly we have to create a new
                ' native font from managed one.
                If (Me.fSysFont <> IntPtr.Zero) Then
                    NativeMethods.DeleteObject(Me.fSysFont)
                End If
                Me.fSysFont = Me.Font.ToHfont()
                NativeMethods.SendMessage(Me.Handle, NativeMethods.WM_SETFONT, Me.fSysFont, CType(1, IntPtr))
            End If
        End Sub

        <PermissionSet(SecurityAction.Demand, Name:="FullTrust")> _
        Protected Overrides Sub WndProc(ByRef m As Message)
            ' If visual theme is changed we have to reinitialize drawing mode to prevent exception being
            ' thrown by TabRenderer when switching from visual styles to "Windows Classic" and vise versa.
            If (m.Msg = NativeMethods.WM_THEMECHANGED) Then
                InitializeDrawMode()
            ElseIf (m.Msg = NativeMethods.WM_PARENTNOTIFY AndAlso (m.WParam.ToInt32() And &HFFFF) = NativeMethods.WM_CREATE) Then
                ' Tab scroller has created(too many tabs to display and tab control is not multiline), so
                ' let's attach our hook to it.
                Dim className As StringBuilder = New StringBuilder(16)
                If (NativeMethods.RealGetWindowClass(m.LParam, className, 16) > 0 AndAlso _
                    className.ToString() = "msctls_updown32") Then
                    fUpDown.ReleaseHandle()
                    fUpDown.AssignHandle(m.LParam)
                End If
            End If
            MyBase.WndProc(m)
        End Sub

        ''' <summary>
        ''' Draws our tab control.
        ''' </summary>
        ''' <param name="g">The <see cref="System.Drawing.Graphics"/> object used to draw tab control.</param>
        ''' <param name="clipRect">The <see cref="System.Drawing.Rectangle"/> that specifies clipping rectangle
        ''' of the control.</param>
        Private Sub DrawCustomTabControl(ByVal g As Graphics, ByVal clipRect As Rectangle)
            ' In this method we draw only those parts of the control which intersects with the
            ' clipping rectangle. It's some kind of optimization.
            If (Not Me.Visible) Then
                Return
            End If

            'selected tab index and rectangle
            Dim iSel As Integer = Me.SelectedIndex
            Dim selRect As Rectangle = If(iSel <> -1, Me.GetTabRect(iSel), Rectangle.Empty)

            Dim rcPage As Rectangle = Me.ClientRectangle
            g.FillRectangle(New SolidBrush(Me.BackColor), rcPage)
            'correcting page rectangle
            Select Case Me.Alignment
                Case TabAlignment.Top
                    Dim trunc As Integer = selRect.Height * Me.RowCount + 2
                    rcPage.Y += trunc
                    rcPage.Height -= trunc
                    Exit Select
                Case TabAlignment.Bottom
                    rcPage.Height -= (selRect.Height + XPTabControl.sAdjHeight) * Me.RowCount
                    Exit Select
            End Select

            'draw page itself
            If (rcPage.IntersectsWith(clipRect)) Then
                TabRenderer.DrawTabPage(g, rcPage)
            End If

            Dim tabCount As Integer = Me.TabCount
            If (tabCount = 0) Then
                Return
            End If

            'drawing unselected tabs
            Me.lastHotIndex = HitTest() 'hot tab
            Dim tabRend As New VisualStyleRenderer(VisualStyleElement.Tab.TabItem.Normal)
            Dim iTab As Integer
            For iTab = 0 To tabCount - 1
                If (iTab <> iSel) Then
                    Dim tabRect As Rectangle = Me.GetTabRect(iTab)
                    If (tabRect.Right >= 3 AndAlso tabRect.IntersectsWith(clipRect)) Then
                        Dim state As TabItemState = If(iTab = Me.lastHotIndex, TabItemState.Hot, TabItemState.Normal)
                        tabRend.SetParameters(tabRend.Class, tabRend.Part, state)
                        DrawTabItem(g, iTab, tabRect, tabRend)
                    End If
                End If
            Next iTab

            ' Drawing selected tab. We'll also increase selected tab's rectangle. It should be a little
            ' bigger than other tabs.
            selRect.Inflate(2, 2)
            If (iSel <> -1 AndAlso selRect.IntersectsWith(clipRect)) Then
                tabRend.SetParameters(tabRend.Class, tabRend.Part, TabItemState.Selected)
                DrawTabItem(g, iSel, selRect, tabRend)
            End If
        End Sub

        ''' <summary>
        ''' Draws certain tab.
        ''' </summary>
        ''' <param name="g">The <see cref="System.Drawing.Graphics"/> object used to draw tab control.</param>
        ''' <param name="index">Index of the tab being drawn.</param>
        ''' <param name="tabRect">The <see cref="System.Drawing.Rectangle"/> object specifying tab bounds.</param>
        ''' <param name="rend">The <see cref="System.Windows.Forms.VisualStyles.VisualStyleRenderer"/> object for rendering the tab.</param>
        Private Sub DrawTabItem(ByVal g As Graphics, ByVal index As Integer, _
                                ByVal tabRect As Rectangle, ByVal rend As VisualStyleRenderer)
            'if scroller is visible and the tab is fully placed under it we don't need to draw such tab
            If (fUpDown.X <= 0 OrElse tabRect.X < fUpDown.X) Then
                Dim tabSelected As Boolean = rend.State = TabItemState.Selected
                ' We will draw our tab on the bitmap and then will transfer image on the control
                ' graphic context.
                Dim bmp As New GDIMemoryContext(g, tabRect.Width, tabRect.Height)
                Dim drawRect As New Rectangle(0, 0, tabRect.Width, tabRect.Height)
                Using bitmapContext As Graphics = bmp.CreateGraphics
                    rend.DrawBackground(bitmapContext, drawRect)
                    If (tabSelected AndAlso tabRect.X = 0) Then
                        Dim corrY As Integer = bmp.Height - 1
                        bmp.SetPixel(0, corrY, bmp.GetPixel(0, corrY - 1))
                    End If
                    ' Important moment. If tab alignment is bottom we should flip image to display tab
                    ' correctly.
                    If (Me.Alignment = TabAlignment.Bottom) Then bmp.FlipVertical()

                    Dim focusRect As Rectangle = Rectangle.Inflate(drawRect, -3, -3) 'focus rect
                    Dim pg As TabPage = Me.TabPages(index) 'tab page whose tab we're drawing
                    'trying to get tab image if any
                    Dim pagePict As Image = Me.GetImageByIndexOrKey(pg.ImageIndex, pg.ImageKey)
                    If (pagePict IsNot Nothing) Then
                        'If tab image is present we should draw it.
                        Dim imgLoc As System.Drawing.Point = If(tabSelected, New System.Drawing.Point(8, 2), New System.Drawing.Point(6, 2))
                        If (Me.Alignment = TabAlignment.Bottom) Then
                            imgLoc.Y = drawRect.Bottom - 2 - pagePict.Height
                        End If
                        bitmapContext.DrawImageUnscaled(pagePict, imgLoc)
                        'Correcting rectangle for drawing text.
                        drawRect.X += imgLoc.X + pagePict.Width
                        drawRect.Width -= imgLoc.X + pagePict.Width
                    End If
                    'drawing tab text
                    TextRenderer.DrawText(bitmapContext, pg.Text, Me.Font, drawRect, rend.GetColor(ColorProperty.TextColor), _
                        TextFormatFlags.SingleLine Or TextFormatFlags.HorizontalCenter Or TextFormatFlags.VerticalCenter)
                    'and finally drawing focus rect(if needed)
                    If (Me.Focused AndAlso tabSelected) Then
                        ControlPaint.DrawFocusRectangle(bitmapContext, focusRect)
                    End If
                End Using
                'If the tab has part under scroller we shouldn't draw that part.
                Dim shift As Integer = If(tabSelected, 2, 0)
                If (fUpDown.X > 0 AndAlso fUpDown.X >= tabRect.X - shift AndAlso fUpDown.X < tabRect.Right + shift) Then
                    tabRect.Width -= tabRect.Right - fUpDown.X + shift
                End If
                bmp.DrawContextClipped(g, tabRect)
            End If
        End Sub

        ''' <summary>
        ''' This function attempts to get tab image by index first or if not set then by key.
        ''' </summary>
        ''' <param name="index">Index of tab image in tab control image list.</param>
        ''' <param name="key">Key of tab image in tab control image list.</param>
        ''' <returns><see cref="System.Drawing.Image"/> that represents image of the tab or null if not assigned.</returns>
        Private Function GetImageByIndexOrKey(ByVal index As Integer, ByVal key As String) As Image
            If (Me.ImageList Is Nothing) Then
                Return Nothing
            ElseIf (index > -1) Then
                Return Me.ImageList.Images(index)
            ElseIf (key.Length > 0) Then
                Return Me.ImageList.Images(key)
            Else
                Return Nothing
            End If
        End Function

        ''' <summary>
        ''' Gets hot tab index.
        ''' </summary>
        ''' <returns>Index of the tab over that the mouse is hovering or -1 if the mouse isn't over any tab.</returns>
        Private Function HitTest() As Integer
            Dim hti As New NativeMethods.TCHITTESTINFO
            Dim mousePos As System.Drawing.Point = Me.PointToClient(TabControl.MousePosition)
            hti.pt.x = mousePos.X
            hti.pt.y = mousePos.Y
            Return NativeMethods.SendMessage(Me.Handle, NativeMethods.TCM_HITTEST, IntPtr.Zero, hti).ToInt32()
        End Function

        ''' <summary>
        ''' This class represents low level hook to updown control used to scroll tabs. We need it to know the
        ''' position of scroller and to draw hot tab as normal when the mouse moves from that tab to scroller.
        ''' </summary>
        <PermissionSet(SecurityAction.Demand, Name:="FullTrust")> _
        Private Class NativeUpDown
            Inherits NativeWindow
            Public Sub New(ByVal ctrl As XPTabControl)
                fparent = ctrl
            End Sub

            Private fx As Integer

            Private fparent As XPTabControl

            ''' <summary>
            ''' Reports about current position of tab scroller.
            ''' </summary>
            Public ReadOnly Property X() As Integer
                Get
                    Return Me.fx
                End Get
            End Property

            Protected Overrides Sub WndProc(ByRef m As Message)
                'if native updown is destroyed we need release our hook
                If (m.Msg = NativeMethods.WM_DESTROY OrElse m.Msg = NativeMethods.WM_NCDESTROY) Then
                    Me.ReleaseHandle()
                ElseIf (m.Msg = NativeMethods.WM_WINDOWPOSCHANGING) Then
                    'When scroller position is changed we should remember that new position.
                    Dim wp As NativeMethods.WINDOWPOS = m.GetLParam(GetType(NativeMethods.WINDOWPOS))
                    Me.fx = wp.x
                ElseIf (m.Msg = NativeMethods.WM_MOUSEMOVE AndAlso fparent.lastHotIndex > 0 AndAlso _
                    fparent.lastHotIndex <> fparent.SelectedIndex) Then
                    'owerdrawing former hot tab as normal
                    Using context As Graphics = Graphics.FromHwnd(fparent.Handle)
                        Dim rend As New VisualStyleRenderer(VisualStyleElement.Tab.TabItem.Normal)
                        fparent.DrawTabItem(context, fparent.lastHotIndex, fparent.GetTabRect(fparent.lastHotIndex), rend)
                        If (fparent.lastHotIndex - fparent.SelectedIndex = 1) Then
                            Dim selRect As Rectangle = fparent.GetTabRect(fparent.SelectedIndex)
                            selRect.Inflate(2, 2)
                            rend.SetParameters(rend.Class, rend.Part, TabItemState.Selected)
                            fparent.DrawTabItem(context, fparent.SelectedIndex, selRect, rend)
                        End If
                    End Using
                ElseIf (m.Msg = NativeMethods.WM_LBUTTONDOWN) Then
                    Dim invalidRect As Rectangle = fparent.GetTabRect(fparent.SelectedIndex)
                    invalidRect.X = 0
                    invalidRect.Width = 2
                    invalidRect.Inflate(0, 2)
                    fparent.Invalidate(invalidRect)
                End If
                MyBase.WndProc(m)
            End Sub
        End Class
    End Class
End Namespace
